home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / util / pathnames.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  1.2 KB  |  41 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2.  
  3. structure Pathnames = struct
  4.  
  5.   fun findChr (ch :string) ((i,s) :int * string) :int =
  6.     let val len = String.length s
  7.         fun find j =
  8.           if j=len
  9.           then 0
  10.           else if ch = substring(s,j,1)
  11.                  then j+1
  12.                  else find (j+1)
  13.     in if (size ch) = 0 then 0 else find i end;
  14.   
  15.   fun explodePath (path:string) :string list =
  16.     let val slash = findChr "/" (0,path)
  17.         val len = size path
  18.     in
  19.       if slash = 0
  20.         then [path]
  21.         else ((substring (path, 0, slash-1)) ::
  22.               (explodePath (substring (path, slash, len - slash))))
  23.     end;
  24.  
  25.   fun implodePath (pathlist :string list) :string =
  26.     let fun merge (x,y) = if y = "" then x else (x ^ "/" ^ y) in
  27.       fold merge pathlist ""
  28.     end;
  29.  
  30.   fun trim (path:string) :string =
  31.     let val parts = explodePath path
  32.         val len = length parts
  33.         val strip' = len - (!System.Print.pathnames) - 1
  34.         val strip = if strip'<=1 then 0 else if strip'>len then len else strip'
  35.         val showParts' = nthtail (parts, strip)
  36.         val showParts = if strip>0 then ("..."::showParts') else showParts'
  37.     in
  38.       implodePath showParts
  39.     end
  40. end
  41.